home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / compuserve-file-archive / 04 geoProgramming / GECOM1.SFX / showfontcom (.txt) < prev    next >
Encoding:
GEOS ConVerT  |  1990-02-12  |  8.5 KB  |  281 lines
  1. SHOW FONT_com
  2. PRG formatted GEOS file V1.0
  3. StarNX-1000C
  4. OP V3.0 or higherNFO
  5. SYSTEM INFO_com
  6. BLASTER'S CONVERTER V2.5
  7. SID-DEMO 5_com
  8. 0"READ-ME FIRST
  9. Write Image V2.0
  10. geoWrite    V2.1
  11. ` Quelltext zur geoCOM-Demodiskette `
  12. ` (c)94 BY DENIS D\HLER/FALK REHWAGEN`
  13. ` Die Demodiskette kann kostenlos angefordert `
  14. ` werden bei: `
  15. ` GUSS, Denis D|hler , Gorkistr.18 , 04347 Leipzig `
  16. CONST $4000,$4500:VAR $4500,$6000
  17. NAME"SHOW FONT"
  18. CLASS"ShowFont    V1.4"
  19. AUTHOR"Falk Rehwagen"
  20. STARTFLAG $40
  21. BYTEVAR AT $84b3; selection
  22. BYTEVAR gr|~e,stil,wait1,wait2,char,y1,y2,num,sizenum
  23. ROW 6000 BYTEVAR fontpuf : ROW 256 BYTEVAR diskblk
  24. ROW 12 BYTEVAR gr|~en
  25. BYTEVAR AT $0402; ypos
  26. BYTEVAR AT $39; pressflag
  27. INTVAR z{hler,x1,x2
  28. STRVAR 16; name : STRVAR 5; string : STRVAR10;typ
  29. FILEVAR datei
  30. LABEL error,mausklick,cr,start,stil_rout,kreuz,stil_rout2,font,set_stil
  31. LABEL size_hoch,size_runter,show_size,taste,size_area,ende
  32. LABEL schleife,set_stil2,ende2
  33.   CLS
  34.   MOUSE ON
  35.   PATTERN 0
  36.   IF(scrflag==$80)THEN
  37.     RECT 60,169,578,194 : FRAME 60,169,578,194
  38.     SETPOS 156,179 : PRINT"/BShowFont Version 1.4/P - (W) 1992-94 Falk Rehwagen"
  39.     SETPOS 134,190 : PRINT"D-04103 Leipzig, Wintergartenstra~e 2//107, Tel.: (0341) 284343"
  40.   ELSE
  41.     RECT 5,169,314,194 : FRAME 5,169,314,194
  42.     SETPOS 36,179 : PRINT"/BShowFont Version 1.4/P - (W) 1992-94 Falk Rehwagen"
  43.     SETPOS 27,190 : PRINT"D-04103 Leipzig, Wintergartenstra~e 2//107, Tel.: (0341) 284343"
  44.   ENDIF
  45. @start
  46.   OPENBOX name,8,"",0
  47.   IF((dbstat<>2)AND(name<>""))THEN
  48.     OPEN datei,name : GOSUB error
  49.     GETBLOCK(PEEK$8413),(PEEK$8414),diskblk
  50.     z{hler=0
  51.     REPEAT
  52.       (gr|~en<z{hler>)=((diskblk<(130+(z{hler*2))>)AND%00011111)
  53.       INC z{hler
  54.     UNTIL(z{hler==12)
  55.     gr|~e=(gr|~en<0>) : sizenum=0
  56.     PTREC datei,gr|~e : GOSUB error
  57.     READ datei,(ADR fontpuf),6000 : GOSUB error
  58.     typ="normal"
  59.     IF(((diskblk<71>)<>$00)AND((diskblk<73>)<>$ff))THEN
  60.       typ="LQ-Font"
  61.     ENDIF
  62.     IF((LEFT name,2)=="LW")THEN
  63.       typ="LW-Font"
  64.     ENDIF    
  65.     PATTERN0 : RECT(DBL9,0),9,(DBL310,1),160
  66.     FRAME(DBL8,0),8,(DBL 311,0),162 : FRAME(DBL8,0),8,(DBL310,1),161
  67.     SETPOS(DBL12,0),17 : PRINT("/P/BMuster der Schrift: /P"+name)
  68.     FRAME(DBL12,0),21,(DBL240,0),157
  69.     SETPOS(DBL244,0),17 : PRINT("/BTyp: /P"+typ)
  70.     FRAME(DBL244,0),24,(DBL306,0),100
  71.     SETPOS(DBL248,0),33 : PRINT"/BSchriftstil:/P"
  72.     SETPOS(DBL262,0),45 : PRINT"normal"
  73.     SETPOS(DBL262,0),55 : PRINT"/Okontur/P"
  74.     SETPOS(DBL262,0),65:PRINT"/Ikursiv/P"
  75.     SETPOS(DBL262,0),75:PRINT"/Rinvers/P"
  76.     SETPOS(DBL262,0),85:PRINT"/Bfett/P"
  77.     SETPOS(DBL26
  78.     SETPOS(DBL262,0),65 : PRINT"/Ikursiv/P"
  79.     SETPOS(DBL262,0),75 : PRINT"/Rinvers/P"
  80.     SETPOS(DBL262,0),85 : PRINT"/Bfett/P"
  81.     SETPOS(DBL262,0),95 : PRINT"/Uunterstr./P":GOSUB stil_rout
  82.     SETPOS(DBL245,0),109 : PRINT"/BPunktgr|~e:/P"
  83.     PATTERN 1
  84.     RECT(DBL247,0),132,(DBL305,0),143 : RECT(DBL247,0),147,(DBL305,0),158
  85.     PATTERN 0
  86.     RECT(DBL245,0),130,(DBL303,0),141 : FRAME(DBL245,0),130,(DBL303,0),141
  87.     RECT(DBL245,0),145,(DBL303,0),156 : FRAME(DBL245,0),145,(DBL303,0),156
  88.     IF(scrflag==$80)THEN
  89.       SETPOS 510,138 : PRINT"anderer Font"
  90.       SETPOS 522,153 : PRINT"verlassen"
  91.     ELSE
  92.       SETPOS 247,138 : PRINT"anderer Font"
  93.       SETPOS 254,153 : PRINT"verlassen"
  94.     ENDIF
  95.     GOSUB size_area : GOSUB font
  96.     @schleife
  97.     ON 0 GOTO taste : ON 1 GOTO mausklick : MAINLOOP
  98.   ENDIF
  99. @error
  100.   IF(iostat==$0b)THEN
  101.     STRNBOX"/BPunktgr|~e zu gro~!/P","Kann nicht gelesen werden!",""
  102.     PATTERN 2
  103.     RECT 0,0,(DBL319,0),162 : CLOSEdatei : WINDOW : GOTO start
  104.   ENDIF
  105.   IF(iostat<>0)THEN
  106.     ERROR
  107.     END
  108.   ENDIF
  109. RETURN
  110.   PUT 13
  111.   PUT char
  112. RETURN
  113. @stil_rout
  114.   num=0 : PATTERN 0
  115.   REPEAT
  116.     GOSUB stil_rout2
  117.     RECT(DBLx1,1),y1,(DBLx2,0),y2 : FRAME(DBLx1,1),y1,(DBLx2,0),y2
  118.     INC num
  119.   UNTIL(num==6)
  120.   IF(stil==0)THEN
  121.     num=0 : kreuz
  122.   ELSE
  123.     num=1 : wait1=(stil/8)
  124.     REPEAT
  125.       IF((wait1AND%00000001)<>0)THEN
  126.         kreuz
  127.       ENDIF
  128.       wait1=(wait1/2)
  129.       INC num
  130.     UNTIL(num==6)
  131.   ENDIF
  132. RETURN
  133. @kreuz
  134.   stil_rout2 : LINE(DBLx1,1),y1,(DBLx2,0),y2 : LINE(DBLx1,1),y2,(DBLx2,0),y1
  135. RETURN
  136. @stil_rout2
  137.   x1=249 : x2=257 : y1=(38+(num*10)) : y2=(46+(num*10))
  138. RETURN
  139. @size_area
  140. @size_area
  141.   PATTERN0
  142.   RECT(DBL251,0),115,(DBL298,0),125 : FRAME(DBL250,0),114,(DBL299,0),126
  143.   FRAME(DBL262,0),114,(DBL287,0),126
  144.   show_size
  145.   LINE(DBL289,1),119,(DBL297,0),119 : LINE(DBL297,0),119,(DBL293,1),123
  146.   LINE(DBL293,1),123,(DBL289,1),119 : LINE(DBL252,1),121,(DBL260,0),121
  147.   LINE(DBL260,0),121,(DBL256,1),117 : LINE(DBL256,1),117,(DBL252,1),121
  148. RETURN
  149. @show_size
  150.   PATTERN 0 : RECT(DBL 263,0),115,(DBL 286,0),125
  151.   string=(STR gr|~e)
  152.   x1=274 : IF(scrflag==$80)THEN
  153.     x1=548
  154.   ENDIF
  155.   SETPOS (x1-((PLEN string)/2)),123 : PRINT string;
  156. RETURN
  157. @mausklick
  158.   UNTIL(mousedata==0)
  159.   INTERRUPT OFF
  160.   IF(REGION(DBL 245,0),130,(DBL 303,0),141) :
  161.     INTERRUPT ON
  162.     INVERT(DBL245,0),130,(DBL303,0),141 : WAITselection : INVERT(DBL245,0),130,(DBL303,0),141
  163.     PATTERN2
  164.     RECT0,0,(DBL319,0),162 : CLOSEdatei : WINDOW : GOTO start
  165.   ENDIF
  166.   IF(REGION(DBL245,0),145,(DBL303,0),156) :
  167.     INTERRUPTON
  168.     INVERT(DBL245,0),145,(DBL303,0),156 : WAITselection : INVERT(DBL245,0),145,(DBL303,0),156
  169.     END
  170.   ENDIF
  171.   IF(REGION(DBL250,0),114,(DBL262,0),126) :
  172.  Gr    INTERRUPTON
  173.     GOTOsize_hoch
  174.   ENDIF
  175.   IF(REGION(DBL287,0),114,(DBL299,0),126) :
  176.     INTERRUPTON
  177.     GOTOsize_runter
  178.   ENDIF
  179.   num=0 : wait1=255
  180.   REPEAT
  181.     stil_rout2
  182.     IF (REGION(DBLx1,0),y1,(DBLx2,0),y2) THEN
  183.     wait1=num : num=5
  184.     ENDIF
  185.     INC num
  186.   UNTIL (num==6)
  187.   INTERRUPT ON
  188.   GOSUB set_stil2
  189. GOTOschleife
  190. @set_stil2
  191.   IF (wait1<>255) THEN
  192.     IF (wait1==0) THEN : stil=0 : ELSE
  193.       wait2=%00000100
  194.       REPEAT
  195.         wait2=(wait2*2)
  196.         DEC wait1
  197.       UNTIL (wait1==0)
  198.       stil=(stilEXORwait2)
  199.     ENDIF
  200.     stil_rout
  201.     font
  202.   ENDIF
  203. RETURN
  204. @taste
  205.   IF(keydata==$10)GOTO size_hoch
  206.   IF(keydat
  207. @taste
  208.   IF(keydata==$10) GOTO size_hoch
  209.   IF(keydata==$11) GOTO size_runter
  210.   IF(keydata==$e3) THEN
  211.     PATTERN 2
  212.     RECT 0,0,(DBL 319,0),162
  213.     CLOSE datei
  214.     WINDOW
  215.     GOTO start
  216.   ENDIF
  217.   IF(keydata==$f1) GOTO ende
  218.   wait1=0 : IF(keydata==$f0) GOTO set_stil2
  219.   wait1=1 : IF(keydata==$ef) GOTO set_stil2
  220.   wait1=2 : IF(keydata==$e9) GOTO set_stil2
  221.   wait1=3 : IF(keydata==$f2) GOTO set_stil2
  222.   wait1=4 : IF(keydata==$e2) GOTO set_stil2
  223.   wait1=5 : IF(keydata==$f5) GOTO set_stil2
  224. GOTO schleife
  225. @ende2
  226.   CLOSE datei : WINDOW
  227. @font
  228.   FONT (OBJECT AT(ADRfontpuf)) : PATTERN0 : RECT(DBL14,0),23,(DBL238,0),155
  229.   WINDOW(DBL14,0),23,(DBL238,0),155 : wait1=1 : wait2=0 : ON 2 GOTOcr : set_stil : HOME
  230.   IF((stilAND%00001000)<>0)THEN
  231.     INCypos
  232.   ENDIF
  233.   REPEAT
  234.     char=((32*wait1)+wait2)
  235.     PUTchar
  236.     INCwait2
  237.     IF (wait2==32) THEN
  238.       wait2=0 : INC wait1 : PUT13
  239.     ENDIF
  240.   UNTIL ((wait2==31) AND (wait1==3))
  241.   PRINT"/P";
  242.   SYSFONT : WINDOW
  243. RETURN
  244. @set_stil
  245.   style=stil
  246. RETURN
  247. @size_hoch
  248.   INVERT(DBL250,0),114,(DBL262,0),126
  249.      INCsizenum
  250.   IF(((gr|~en<sizenum>)==0) OR (sizenum==11)) THEN
  251.    sizenum=0
  252.   ENDIF
  253.   gr|~e=(gr|~en<sizenum>)
  254.     show_size
  255.     WAITselection
  256.   INVERT(DBL250,0),114,(DBL262,0),126
  257.   PTRECdatei,gr|~e : error
  258.   READdatei,(ADR(fontpuf<0>)),6000 : error
  259.   font
  260. GOTOschleife
  261. @size_runter
  262.   INVERT(DBL287,0),114,(DBL299,0),126
  263.     DECsizenum
  264.   IF(sizenum==255) THEN
  265.     sizenum=11
  266.     REPEAT
  267.       DECsizenum
  268.     UNT
  269.     UNTIL((gr|~en<sizenum>)<>0)
  270.   ENDIF
  271.     gr|~e=(gr|~en<sizenum>)
  272.     show_size
  273.    WAITselection
  274.   INVERT(DBL287,0),114,(DBL299,0),126
  275.   PTRECdatei,gr|~e : error
  276.   READdatei,(ADR(fontpuf<0>)),6000 : error
  277.   font
  278. GOTO schleife
  279. @ende
  280. INVERT(DBL245,0),145,(DBL303,0),156 : WAITselection : INVERT(DBL245,0),145,(DBL303,0),156
  281.